home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / assembly / 3dstars.lha / 3DStars.s < prev    next >
Encoding:
Text File  |  1994-01-03  |  8.4 KB  |  396 lines
  1. ***************************************************************************
  2. *** 3D Star Routine                   (c) 1990 by McDeal/D-TECT ***
  3. *** This is a (Master-) Devpac source!                    ***
  4. ***************************************************************************
  5.  
  6.         opt    o+,w-,c-
  7.  
  8. *** Use joystick to control the stars !!! ***
  9.  
  10. * The control of the stars is lame, I know! I had a better version but the
  11. * source would have been bigger so I decide to use this version. (The other
  12. * included a x,y,z rotation with matrix calculation, etc.)
  13. * Don't forget to press the firebottom!!!
  14.  
  15. PlaneHeight    = 255
  16. PlaneWidth    = 40
  17. PlaneLen    = PlaneHeight*PlaneWidth
  18. PL        = PlaneLen
  19. PlaneBLTSIZE    = 3*PlaneHeight*64+(PlaneWidth/2)
  20.  
  21. MaxTiefe    = $2000
  22. StarCount    = 335
  23. X        = 160
  24. Y        = 128
  25. Z        = 256
  26. ClipX        = 319
  27. ClipY        = 254
  28. JoySpeed    = 5
  29.  
  30. ***************************************************
  31. *** MACRO-Definition                ***
  32. ***************************************************
  33.  
  34. WAITBLITT:    MACRO
  35.         btst    #6,$02(a6)
  36. .\@:        btst    #6,$02(a6)
  37.         bne.s    .\@
  38.         ENDM
  39.  
  40. ***************************************************
  41. *** ProgrammStart                ***
  42. ***************************************************
  43.  
  44.         section    a,code_c
  45.  
  46. Start:        lea    $dff000,a6
  47.         move.w    #$4000,$9a(a6)
  48.  
  49.         bsr    RandomStars
  50.         bsr.s    CalcTab
  51.         bsr.s    MakePerspTab
  52.         bsr.s    StartCopper
  53.         bsr    Main
  54.         bsr.s    StopCopper
  55.  
  56.         move.w    #$c000,$9a(a6)
  57.         moveq    #0,d0
  58.         rts
  59.  
  60. ***************************************************
  61. *** Copper Init                    ***
  62. ***************************************************
  63.  
  64. StartCopper:    move.w    #$0780,$96(a6)
  65.         move.l    #NCList,$84(a6)
  66.         clr.w    $8a(a6)
  67.         move.w    #$8380,$96(a6)
  68.         rts
  69.  
  70. StopCopper:    move.w    #$0380,$96(a6)
  71.         clr.w    $88(a6)
  72.         move.w    #$8380,$96(a6)
  73.         rts
  74.  
  75. ***************************************************
  76. *** Build Y Table                ***
  77. ***************************************************
  78.  
  79. CalcTab:    lea    YTab(pc),a0
  80.         moveq    #0,d0
  81.         move.w    #PlaneHeight-1,d7
  82. .Loop:        move.w    d0,(a0)+
  83.         add.w    #PlaneWidth,d0
  84.         dbra    d7,.Loop
  85.         rts
  86.  
  87. ***************************************************
  88. *** Build Division Table            ***
  89. ***************************************************
  90.  
  91. MakePerspTab:    lea    PerspTab,a1
  92.         move.w    #Z,d0
  93.         add.w    d0,a1
  94.         add.w    d0,a1
  95.         move.w    #Z,d2
  96.         mulu    #$7fff,d2
  97. .Loop:        move.l    d2,d1
  98.         divu    d0,d1
  99.         move.w    d1,(a1)+
  100.         addq.w    #1,d0
  101.         cmp.w    #MaxTiefe,d0
  102.         bne.s    .Loop
  103.         rts
  104.  
  105. ***************************************************
  106. *** Random Stars                ***
  107. ***************************************************
  108.  
  109. RandomStars:    lea    StarDatas,a0
  110.         move.w    #$1fff,d3
  111.         move.w    #StarCount-1,d7
  112.  
  113. .Loop:        bsr.s    GetWord            ;X Word
  114.         add.w    #X,d2
  115.         and.w    d3,d2
  116.         sub.w    #X,d2
  117.         move.w    d2,(a0)+
  118.         bsr.s    GetWord            ;Y Word
  119.         add.w    #Y,d2
  120.         and.w    d3,d2
  121.         sub.w    #Y,d2
  122.         move.w    d2,(a0)+
  123.         bsr.s    GetWord            ;Z Word
  124.         add.w    #Z,d2
  125.         and.w    d3,d2
  126.         sub.w    #Z,d2
  127.         move.w    d2,(a0)+
  128.         dbf    d7,.Loop
  129.         rts
  130.  
  131. GetWord:    bsr.s    GetByte
  132.         move.b    d0,d2
  133.         lsl.w    #8,d2
  134.         bsr.s    GetByte
  135.         move.b    d0,d2
  136.         rts
  137.  
  138. GetByte:    move.b    $dff007,d0
  139.         move.b    $bfd800,d1
  140.         eor.b    d1,d0
  141.         moveq    #0,d1
  142.         move.b    d0,d1
  143.         ror.b    #1,d1
  144. .loop:        dbf    d1,.loop
  145.         rts
  146.  
  147. ***************************************************
  148. *** Main Loop                    ***
  149. ***************************************************
  150.  
  151. Main:        btst    #2,$16(a6)
  152.         beq.s    Main
  153.         move.l    $04(a6),d0
  154.         and.l    #$1ff00,d0
  155.         cmp.l    #300*256,d0
  156.         bne.s    Main
  157.  
  158.         bsr    ClearPlane
  159.         bsr    JoyControl
  160.         bsr.s    New3DStars
  161.         lea    $dff000,a6
  162.         bsr    ChangePlanes
  163.  
  164.         move.w    #$444,$180(a6)
  165.         moveq    #20,d7
  166. .Loop:        dbra    d7,.Loop
  167.         move.w    #$000,$180(a6)
  168.  
  169.         btst    #6,$bfe001
  170.         bne.s    Main
  171.         WAITBLITT
  172.         rts
  173.  
  174. ***************************************************
  175. *** 3D Star Routine                ***
  176. ***************************************************
  177.  
  178. New3DStars:    move.w    #StarCount-1,d7        ;64 Stars
  179.         lea    StarDatas,a0        ;Ptr StarDatas
  180.         lea    PerspTab,a1        ;Projection Table
  181.         movem.w    XAdd(pc),a4-a6        ;Put coordinate adds in regs
  182.         move.w    #ClipX,a3        ;Clipping constante
  183.         move.w    #ClipY,d5
  184.         move.w    #$1fff,d3
  185.         move.w    #$1000,d4        ;middle value
  186.         add.w    d4,a4            ;+x add
  187.         add.w    d4,a5            ;+y add
  188.  
  189. .Loop:        movem.w    (a0),d0-d2        ;Get coordinate
  190.  
  191.         add.w    a4,d0            ;add middle and de/increase x
  192.         and.w    d3,d0            ;check overflow
  193.         sub.w    d4,d0            ;sub middle
  194.         add.w    a5,d1            ;add middle and de/increase y
  195.         and.w    d3,d1            ;check overflow
  196.         sub.w    d4,d1            ;sub middle
  197.         add.w    a6,d2            ;de/increase z
  198.         and.w    d3,d2            ;check overflow
  199.  
  200.         movem.w    d0-d2,(a0)        ;save coords
  201.         addq.w    #6,a0            ;(there is no movem.w d0,(a0)+)
  202.  
  203. ; >--- Projection, vlipping und plot
  204. ;/
  205.  
  206. .SetStar:    cmp.w    #Z,d2            ;z<d2?
  207.         blt.s    .Next            ;-> Next star
  208.         add.w    d2,d2            ;Z*2
  209.         move.w    (a1,d2.w),d6        ;Projektionswert holen
  210.  
  211. ;It's very important to do the following commands in this order. It's very
  212. ;stupid of you do it like this:
  213. ;            muls    d6,d0
  214. ;            muls    d6,d1
  215. ;            swap    d0
  216. ;            swap    d1
  217. ;            etc...
  218. ;Ok, the source looks better but there is one BIG disadvantage!!! If e.g.
  219. ;the x value isn't in the screen you don't have the plot this pixel. But
  220. ;if the pixel musn't be plot it is really stupid to check/calculate the
  221. ;y value!!! Understood??? The following routine is much better! It first
  222. ;checks if the x value is within the screen. If it is, the y value will be
  223. ;calculated. If not, the y value won't be calculated (We can't save the
  224. ;unneccessary 'muls d6,d1' in this case!!!
  225.  
  226.         muls    d6,d0            ;projection
  227.         swap    d0            ;
  228.         add.w    #X,d0            ;X middle of screen (160)
  229.         cmp.w    a3,d0            ;a3=ClipX (Clipping)
  230.         bhi.s    .Next            ;Don't plot
  231.  
  232.         muls    d6,d1            ;projection
  233.         swap    d1
  234.         add.w    #Y,d1            ;Y middle of screen (128)
  235.         cmp.w    d5,d1            ;a4=ClipY
  236.         bhi.s    .Next            ;Don't plot
  237.  
  238.         move.l    WorkPlane(pc),a2    ;plot pixel
  239.         move.w    d0,d6
  240.         lsr.w    #3,d6
  241.         add.w    d6,a2
  242.         add.w    d1,d1
  243.         add.w    YTab(pc,d1.w),a2
  244.         not.w    d0
  245.  
  246.         rol.w    #6,d2            ;get color
  247.         and.w    #$e,d2
  248.         move.w    .JT(pc,d2.w),d2
  249.         jmp    .JT(pc,d2.w)
  250.  
  251. .JT:        dc.w    .r6-.JT,.r6-.JT,.r5-.JT,.r4-.JT
  252.         dc.w    .r3-.JT,.r2-.JT,.r1-.JT,.r0-.JT
  253.  
  254. .r0:        bset    d0,(a2)            ;plot routines...
  255. .next:        dbf    d7,.Loop
  256.         rts
  257. .r1:        bset    d0,PL(a2)
  258.         dbf    d7,.Loop
  259.         rts
  260. .r2:        bset    d0,(a2)
  261.         bset    d0,PL(a2)
  262.         dbf    d7,.Loop
  263.         rts
  264. .r3:        bset    d0,PL*2(a2)
  265.         dbf    d7,.Loop
  266.         rts
  267. .r4:        bset    d0,(a2)
  268.         bset    d0,PL*2(a2)
  269.         dbf    d7,.Loop
  270.         rts
  271. .r5:        bset    d0,PL(a2)
  272.         bset    d0,PL*2(a2)
  273.         dbf    d7,.Loop
  274.         rts
  275. .r6:        bset    d0,(a2)
  276.         bset    d0,PL(a2)
  277.         bset    d0,PL*2(a2)
  278.         dbf    d7,.Loop
  279.         rts
  280.  
  281. XAdd:        dc.w    0
  282. YAdd:        dc.w    0
  283. ZAdd:        dc.w    -100
  284.  
  285. YTab:        ds.w    PlaneHeight
  286.  
  287. ***************************************************
  288. *** Joystick Control                ***
  289. ***************************************************
  290.  
  291. JoyControl:    lea    XAdd(pc),a0
  292.         lea    ZAdd(pc),a1
  293.         tst.b    $bfe001            ;Y or Z?
  294.         bpl.s    .Pressed        ;Z-> Pressed
  295.  
  296.         lea    YAdd(pc),a1        ;otherwise Y
  297.  
  298. .Pressed:    move.w    $0c(a6),d0
  299.         btst    #1,d0
  300.         beq.s    .TstLinks
  301.         subq.w    #JoySpeed,(a0)
  302.         bra.s    .DoY
  303. .TstLinks:    btst    #9,d0
  304.         beq.s    .DoY
  305.         addq.w    #JoySpeed,(a0)
  306.  
  307. .DoY:        move.w    d0,d1
  308.         lsr.w    #1,d1
  309.         eor.w    d0,d1
  310.         btst    #0,d1
  311.         beq.s    .TstVorne
  312.         addq.w    #JoySpeed,(a1)
  313.         bra.s    .Exit
  314. .TstVorne:    btst    #8,d1
  315.         beq.s    .Exit
  316.         subq.w    #JoySpeed,(a1)
  317. .Exit:        rts
  318.  
  319. ***************************************************
  320. *** clear DelPlane                ***
  321. ***************************************************
  322.  
  323. ClearPlane:    WAITBLITT
  324.  
  325.         move.l    DelPlane(pc),$54(a6)
  326.         clr.w    $66(a6)
  327.         move.l    #$01000000,$40(a6)
  328.         move.w    #PlaneBLTSIZE,$58(a6)
  329.         rts
  330.  
  331. ***************************************************
  332. *** Tripple Buffering                ***
  333. ***************************************************
  334.  
  335. ChangePlanes:    lea    Plane(pc),a0
  336.         movem.l    (a0),d0-d2
  337.         exg    d0,d1
  338.         exg    d1,d2
  339.         movem.l    d0-d2,(a0)
  340.         lea    PlanePtrs(pc),a0
  341.         move.w    d0,6(a0)
  342.         swap    d0
  343.         move.w    d0,2(a0)
  344.         swap    d0
  345.         add.l    #PlaneLen,d0
  346.         move.w    d0,6+8(a0)
  347.         swap    d0
  348.         move.w    d0,2+8(a0)
  349.         swap    d0
  350.         add.l    #PlaneLen,d0
  351.         move.w    d0,6+16(a0)
  352.         swap    d0
  353.         move.w    d0,2+16(a0)
  354.         swap    d0
  355.         rts
  356.  
  357. Plane:        dc.l    Plane1
  358. WorkPlane:    dc.l    Plane2
  359. DelPlane:    dc.l    Plane3
  360.  
  361. ***************************************************
  362. *** Datas                    ***
  363. ***************************************************
  364.  
  365. * Try Germany/0+$4498a7c!!! (Ask for Karsten!)
  366.  
  367. NCList:        dc.l    $01200000,$01220000,$01240000,$01260000
  368.         dc.l    $01280000,$012a0000,$012c0000,$012e0000
  369.         dc.l    $01300000,$01320000,$01340000,$01360000
  370.         dc.l    $01380000,$013a0000,$013c0000,$013e0000
  371.  
  372.         dc.l    $008e2c81,$00902bc1,$00920038,$009400d0
  373.         dc.l    $01020000,$01040000,$01080000,$010a0000
  374.         dc.l    $01000200
  375.  
  376. PlanePtrs:    dc.l    $00e00000,$00e20000,$00e40000,$00e60000
  377.         dc.l    $00e80000,$00ea0000
  378.         dc.l    $01003200
  379.  
  380.         dc.l    $01800000,$01820333,$01840555,$01860777
  381.         dc.l    $01880999,$018a0bbb,$018c0ddd,$018e0fff
  382.         dc.l    -2
  383.  
  384. ***************************************************
  385. *** BSS Data segment                ***
  386. ***************************************************
  387.  
  388.         section    b,bss_c
  389.  
  390. Plane1:        ds.b    PlaneLen*3
  391. Plane2:        ds.b    PlaneLen*3
  392. Plane3:        ds.b    PlaneLen*3
  393. PerspTab:    ds.w    MaxTiefe
  394. StarDatas:    ds.w    StarCount*3
  395.  
  396.